home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Contributed Scores / Piano Inventions / Invention 6b < prev    next >
Lisp/Scheme  |  1998-10-26  |  2KB  |  73 lines
  1. ; Invention VIb - solo keyboard  (24/11/93) 
  2.  
  3. (create-tonality I '(d& 4 b& 4 c 5 e& 5 a& 5))
  4. (create-tonality II '(f 4 d 5 e 5 a 5 b 5))
  5. (create-tonality III '(b 3 g# 4 a# 4 c# 5 f# 5))
  6. (create-tonality IV '(c 4 g 4 a 4 d 5 f 5))
  7.  
  8. (setq ntimes 20)
  9. (setq ntimes1 4)
  10. (setq seed 0.34)
  11.  
  12. (setq mat '(a b c d e))
  13. (setq chd '(abcde bcd eca de bcde))
  14.  
  15. (setq matx (gen-random seed (* ntimes (length mat)) mat))
  16. (setq chdx (gen-random seed (length chd) chd))
  17.  
  18. (setq len '(1/16))
  19. (setq lenx (symbol-repeat (length matx) len))
  20.  
  21.  
  22. (setq zon  '(5/16 7/16 11/16 13/16 17/16))
  23. (setq zonr (symbol-repeat ntimes '(5/16)))
  24. (setq zonx (gen-random seed (length zon) zon))
  25.  
  26. (setq tons (gen-random seed ntimes '(a b c d)))
  27. ;-> (b a a a b b c c c c a b b c b d b d d b)
  28. (setq tonal (pick-tonality ("piano-studies" seed  
  29.                             I II III IV I   
  30.                             b a a a b b c c c c a b b c b d b d d b 
  31.                             II III IV III II 
  32.                             b a a a b b c c c c a b b c b d b d d b
  33.                             III IV III II I 
  34.                             b a a a b b c c c c a b b c b d b d d b
  35.                             II IV III I IV)))
  36.     
  37. (def-tonality
  38.   instr tonal
  39. )
  40.  
  41. (def-symbol
  42.   instr (append chd 
  43.                 matx 
  44.                 chdx
  45.                 (symbol-mix (filter-delete 'c matx)
  46.                             (fill-rest (filter-delete 'c matx)  
  47.                                        (symbol-transpose -7 matx)))
  48.                 chdx
  49.                 (symbol-chordize seed (length matx) 5 nil
  50.                                  (filter-midpass 'b 'd matx))
  51.                 chd)
  52.   )
  53.  
  54. (def-length
  55.   instr (append zon lenx zonx lenx zonx lenx zon)
  56. )
  57.  
  58. (def-zone
  59.   instr (append zon zonr zonx zonr zonx zonr zon)
  60. )
  61.  
  62. (def-velocity
  63.   instr (vector-round 45 96
  64.           (gen-noise-white (length (get-symbols-of 'instr)) 0.3))
  65. )
  66.  
  67. (compile-instrument "ccl;output:"  separate
  68.   instr
  69. )
  70.  
  71.  
  72.  
  73.